#!/usr/bin/perl -w

# irclog2html.pl Version 1.5 - 11th May 2000
# Copyright (C) 2000, Jeffrey W. Waugh

# Author:
#   Jeff Waugh <jdub@aphid.net>

# Contributors:
#   Rick Welykochy <rick@praxis.com.au>
#   Alexander Else <aelse@uu.net>

# Released under the terms of the GNU GPL
# http://www.gnu.org/copyleft/gpl.html

# Modified by Tim Riker <Tim@Rikers.org>
# to work with infobot logs
# then modified again for infobot

# Usage: irclog2html <date> < logfile

# irclog2html will write out a colourised irc log, appending a .html
# extension to the output file.

####################################################################################
# Perl Configuration

use strict;
$^W = 1;    #RW# turn on warnings
use POSIX qw(strftime);

####################################################################################
# Preferences

# Comment out the "table" assignment to use the plain version

#my $STYLE		=	"tt";
#my $STYLE		=	"simplett";
#my $STYLE		=	"table";
my $STYLE = "simpletable";

my $colour_left       = "#000099";    # nick leaving channel
my $colour_joined     = "#009900";    # nick joining channel
my $colour_server     = "#009900";    # server message (***)
my $colour_nickchange = "#009900";    # nick change
my $colour_action     = "#CC00CC";    # nick action (/me waves)

my %prefs_colour_nick = (
    "jdub"      => "#993333",
    "cantanker" => "#006600",
    "chuckd"    => "#339999",
);

####################################################################################
# Utility Functions

sub header {
    my ( $channel, $date ) = @_;
    my $return = '';

    $return .=
      qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
	<title>irclog2html for $channel on $date</title>
	<meta name="generator" content="irclog2html.pl by Jeff Waugh">
	<meta name="version" content="Version 1.5 - 11th May 2000">
	<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
</head>
<body text="#000000" bgcolor="#ffffff">
<h1>irclog2html for $channel on $date</h1>
};

    if ( $STYLE =~ /table/ ) {
        $return .= "<table cellspacing=3 cellpadding=2 border=0>\n";
    }
    return $return;
}

sub footer {
    my $return = '';
    if ( $STYLE =~ /table/ ) {
        $return .= "</table>\n";
    }

    $return .= qq{
<br>Generated by irclog2html.pl by
<a href="mailto:jdub\@NOSPAMaphid.net">Jeff Waugh</a> - find it at
<a href="http://freshmeat.net/appindex/2000/03/28/954251322.html">freshmeat.net</a>!
Modified by <a href="http://www.Rikers.org">Tim Riker</a> to work with
<a href="http://infobot.sourceforge.net/">infobot</a> logs, split per channel, etc.
</body></html>
};
    return $return;
}

my $lastdate = '';

sub add_footers {
    my $filename;

    return if not $lastdate;

    my @files = `ls $lastdate.html */$lastdate.html`;
    foreach $filename (@files) {
        chomp $filename;
        if ( !open( OUTPUT, ">>$filename" ) ) {
            print "Cannot open $filename for writing!\n\n";
            return;
        }
        print OUTPUT footer();
        close OUTPUT;
    }
}

sub output_line {
    my ( $date, $time, $channel, $lineout ) = @_;

    add_footers() if $lastdate ne $date;

    $lastdate = $date;
    my $filename = "";
    $filename .= "$channel/" if $channel;
    $filename .= "$date.html";

    mkdir( $channel, oct('755') ) if ( $channel && !-d $channel );
    if ( !open( OUTPUT, ">>$filename" ) ) {

        #print "Cannot open $filename for writing!\n\n";
        return;
    }

    # Begin output #
    print OUTPUT header( $channel, $date ) if -z $filename;

    print OUTPUT $lineout;

    close OUTPUT;
}

sub output_timenicktext {
    my ( $date, $time, $channel, $nick, $text, $htmlcolour ) = @_;
    my $lineout = '';

    if ( $STYLE eq "table" ) {
        $lineout .= "<tr>";
        $lineout .=
"<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$time</tt></font></td>"
          if $time;
        $lineout .=
"<td bgcolor=\"$htmlcolour\"><font color=\"#ffffff\"><tt>$nick</tt></font></td>";
        $lineout .=
"<td width=\"100%\" bgcolor=\"#eeeeee\"><tt><font color=\"$htmlcolour\">$text<\/font></tt></td></tr>\n";
    }
    elsif ( $STYLE eq "simpletable" ) {
        $lineout .= "<tr bgcolor=\"#eeeeee\">";
        $lineout .= "<td><tt>$time</tt></td>" if $time;
        $lineout .=
          "<td><font color=\"$htmlcolour\"><tt>$nick</tt></font></td>";
        $lineout .= "<td width=\"100%\"><tt>$text</tt></td></tr>\n";
    }
    elsif ( $STYLE eq "simplett" ) {
        $lineout .= "$time " if $time;
        $lineout .= "&lt\;$nick&gt\; $text<br>\n";
    }
    else {
        $lineout .= "$time " if $time;
        $lineout .=
          "<font color=\"$htmlcolour\">&lt\;$nick&gt\; $text<\/font><br>\n";
    }
    output_line( $date, $time, $channel, $lineout );
}

sub output_timeservermsg {
    my ( $date, $time, $channel, $line ) = @_;
    my $lineout = '';

    if ( $STYLE =~ /table/ ) {
        $lineout .= "<tr>";
        $lineout .= "<td><tt>$time</tt></td>" if $time;
        $lineout .= "<td colspan=2><tt>$line</tt></td></tr>\n";
    }
    else {
        $lineout .= "$time " if $time;
        $lineout .= "$line<br>\n";
    }
    output_line( $date, $time, $channel, $lineout );
}

sub html_rgb {
    my ( $i, $ncolours ) = @_;
    $ncolours = 1 if $ncolours == 0;

    my $rgbmax = 125;    # tune these two for the outmost ranges of colour depth
    my $rgbmin = 240;

    my $a =
      0.95;    # tune these for the starting and ending concentrations of R,G,B
    my $c = 0.5;

    my $rgb = [
        [ $a, $c, $c ],
        [ $c, $a, $c ],
        [ $c, $c, $a ],
        [ $a, $a, $c ],
        [ $a, $c, $a ],
        [ $c, $a, $a ]
    ];
    my $n = $i % @$rgb;
    my $m = $rgbmin + ( $rgbmax - $rgbmin ) * ( $ncolours - $i ) / $ncolours;

    my $r = $rgb->[$n][0] * $m;
    my $g = $rgb->[$n][1] * $m;
    my $b = $rgb->[$n][2] * $m;
    sprintf( "#%02x%02x%02x", $r, $g, $b );
}

####################################################################################
# Main

sub main {
    my ($date) = @_;
    my $files;

    my $line;
    my $time;
    my $lastdate = "";
    my $nick;
    my $channel;
    my $text;

    my $htmlcolour;
    my $nickcount = 0;
    my $NICKMAX   = 30;

    my %colour_nick = %prefs_colour_nick;

    while ( $line = <STDIN> ) {

        chomp $line;

        if ( !$line eq "" ) {

            # parse out the time
            if ( $line =~ s/^([0-9:\.]*) (.*)$/$2/ ) {
                $time = $1;
            }
            else {
                $time = '';
            }
            $channel = '';

            # Replace ampersands, pointies, control characters #
            $line =~ s/&/&amp\;/g;
            $line =~ s/</&lt\;/g;
            $line =~ s/>/&gt\;/g;
            $line =~ s/\e\[[0-1]*m//g;
            $line =~ s/[\x00-\x1f]+//g;

            # Replace possible URLs with links #
            $line =~
              s/((http|https|ftp|gopher|news):\/\/\S*)/<a href="$1">$1<\/a>/g;

            # Colourise the comments
            if ( $line =~ /^&lt\;[^\/]*?\/\#.*?&gt\; .*$/ ) {

                # Split $nick, $channel and $line
                $nick = $line;
                $nick =~ s/^&lt\;([^\/]*?)\/\#.*?&gt\; .*$/$1/;
                $channel = $line;
                $channel =~ s/^&lt\;[^\/]*?\/(\#.*?)&gt\; .*$/$1/;

             # $nick =~ tr/[A-Z]/[a-z]/;
             # <======= move this into another function when getting nick colour

                $text = $line;
                $text =~ s/^&lt\;.*?&gt\; (.*)$/$1/;
                $text =~ s/^ .*/&lt\;PROTECTED&gt\;/g;
                $text =~ s/  /&nbsp\;&nbsp\;/g;

                $htmlcolour = $colour_nick{$nick};
                if ( !defined($htmlcolour) ) {

                    # new nick
                    $nickcount++;

              # if we've exceeded our estimate of the number of nicks, double it
                    $NICKMAX *= 2 if $nickcount >= $NICKMAX;

                    $htmlcolour = $colour_nick{$nick} =
                      html_rgb( $nickcount, $NICKMAX );
                }
                output_timenicktext( $date, $time, $channel, $nick, $text,
                    $htmlcolour );
            }
            elsif ( $line =~ /^&gt\;&gt\;&gt\; / ) {
                $line =~ s/^&gt\;&gt\;&gt\; /\*\*\* /;

              # Process changed nick results, and remember colours accordingly #
                if ( $line =~ /\*\*\* (.*?) materializes into (.*)/ ) {
                    my $nick_old = $1;
                    my $nick_new = $2;

                    #$nick_old = $line;
                    #$nick_old =~ s/\*\*\* (.*?) materializes into .*/$1/;
                    #$nick_new = $line;
                    #$nick_new =~ s/\*\*\* (.*?) materializes into (.*)/$2/;

                    $colour_nick{$nick_new} = $colour_nick{$nick_old};
                    $colour_nick{$nick_old} = undef;

                    $line =~
s/(\*\*\* .*)/<font color=\"$colour_nickchange\">$1<\/font>/;
                }
                elsif ( $line =~ /\*\*\* (join|mode|topic)\/(.*?) .*/ ) {
                    $channel = lc $2;
                    $line =~
                      s/(\*\*\* .*)/<font color=\"$colour_joined\">$1<\/font>/;
                }
                elsif ( $line =~ /\*\*\* (part|kick|banned)\/(.*?) .*/ ) {
                    $channel = lc $2;
                    $line =~
                      s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
                }
                elsif ( $line =~ /\*\*\* .* has signed off IRC .*/ ) {

                    # Colourise joined/left/server messages #
                    $line =~
                      s/(\*\*\* .*)/<font color=\"$colour_left\">$1<\/font>/;
                }
                elsif ( $line =~ /\*\*\* / ) {
                    $line =~
                      s/(\*\*\* .*)$/<font color=\"$colour_server\">$1<\/font>/;
                }
                elsif ( $line =~ /^\* .*$/ ) {

                    # Colourise the /me's #
                    $line =~
                      s/^(\*.*)$/<font color=\"$colour_action\">$1<\/font>/;
                }

                output_timeservermsg( $date, $time, $channel, $line );
            }
        }
    }

    add_footers();

    return 0;
}

if ( !scalar @ARGV ) {
    print "Usage: irclog2html.pl <date> < logfile\n";
    print
      "Example: bzcat log/infobot.log-20021104.bz2 | irclog2html.pl 20021104\n";
    exit 0;
}
my $date = shift;
exit &main($date);

# vim:ts=4:sw=4:expandtab:tw=80
